home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / com / computer / casio_st / casiost2.lst < prev    next >
File List  |  1994-03-01  |  13KB  |  616 lines
  1. $e
  2. $i+
  3. $s<
  4. $m 100000
  5. '
  6. ' Liaison Casio Fx 850p - Atari St (sources GFA 3.5)
  7. ' (c) William Saint-Cricq
  8. '
  9. ' Diffusion libre de ces sources sauf
  10. ' pour utilisation commerciale dans quel
  11. ' cas il faudra demand‚ l'autorisation de
  12. ' l'auteur.
  13. ' Toutes modifications du programme est
  14. ' autoris‚es si le nom de l'auteur est
  15. ' bien respect‚.
  16. '
  17. '                                  Merci.
  18. '
  19. CLEAR
  20. version$="2.02"
  21. dat$="F‚vrier 1992"
  22. '
  23. HIDEM
  24. '
  25. IF XBIOS(4)<>2
  26.   ALERT 3,"|Uniquement en monochrome ",1," SORRY ",ret%
  27.   END
  28. ENDIF
  29. IF FRE(0)-32000<=0
  30.   ALERT 3,"|Pas assez de m‚moire",0," OK ",ret%
  31.   END
  32. ENDIF
  33. '
  34. ' RESERVE FRE(0)-32000
  35. @charge_ecran
  36. '
  37. IF fin!
  38.   END
  39. ENDIF
  40. '
  41. @init
  42. '
  43. ON MENU BUTTON 1,1,1 GOSUB gere_souris
  44. ON MENU KEY GOSUB gere_clavier
  45. DO
  46.   ON MENU
  47.   EXIT IF fin!
  48. LOOP
  49. END
  50. '
  51. ' ********************** routines principales
  52. > PROCEDURE charge_ecran
  53.   INLINE adr_doc%,32000
  54.   '  adr_doc=MALLOC(32000)
  55.   ' IF adr_doc=0
  56.   ' PRINT "Pas assez de m‚moire !"
  57.   ' @fin
  58.   ' ELSE
  59.   ' BLOAD "DOC.PIC",adr_doc
  60.   ' ENDIF
  61.   INLINE adr_som%,32000
  62.   '  adr_som=MALLOC(32000)
  63.   '  IF adr_som=0
  64.   '  PRINT "Pas assez de m‚moire !"
  65.   '  @fin
  66.   ' ELSE
  67.   '  BLOAD "SOMMAIRE.PIC",adr_som
  68.   ' ENDIF
  69. RETURN
  70. > PROCEDURE init
  71.   ' Mise en place tampon Rs232 avec sauvegarde de l'ancien
  72.   '       Ancien Tampon
  73.   ad%=XBIOS(14,0)
  74.   initin%=LPEEK(ad%)
  75.   longin%=DPEEK(ad%)
  76.   ad%=XBIOS(14,0)+14
  77.   initout%=LPEEK(ad%)
  78.   longout%=DPEEK(ad%)
  79.   '       Nouveau Tampon
  80.   xxxin%=GEMDOS(&H48,L:256)     ! Malloc
  81.   xbios14in(xxxin%,256)         ! Buffer d'entr‚e
  82.   xxxout%=GEMDOS(&H48,L:16)     ! Malloc
  83.   xbios14out(xxxout%,16)        ! Buffer de sortie
  84.   '
  85.   '
  86.   erreur!=FALSE
  87.   fin!=FALSE
  88.   ok!=FALSE
  89.   CLR programme$          ! variable o— il y a le programme CASIO
  90.   ~XBIOS(&H21,&X100)
  91.   @aff_som
  92.   nom_prog$="CASIO.CAS"
  93.   prog$="CASIO.CAS"
  94.   nbe_octets$="0"
  95.   nbe_lignes$="0"
  96.   statut$="Attente..."
  97.   vitesse$="1200"
  98.   no_serie$=@no_serie$
  99.   '  IF chemin$=""
  100.   ' chemin$="*.*"
  101.   ' ENDIF
  102.   @info_memoire
  103.   @affiche_info
  104.   SHOWM
  105.   DEFMOUSE 3
  106. RETURN
  107. > PROCEDURE xbios14out(adr%,l%)
  108.   LOCAL ad%
  109.   ad%=XBIOS(14,0)+14
  110.   SLPOKE ad%,adr%
  111.   SDPOKE ad%+4,l%
  112.   SLPOKE ad%+6,0
  113.   PAUSE 10
  114. RETURN
  115. > PROCEDURE xbios14in(adr%,l%)
  116.   LOCAL ad%
  117.   ad%=XBIOS(14,0)
  118.   SLPOKE ad%,adr%
  119.   SDPOKE ad%+4,l%
  120.   SLPOKE ad%+6,0
  121.   PAUSE 10
  122. RETURN
  123. > FUNCTION no_serie$
  124. LOCAL a$,b$,a%
  125. a$=" WTel"
  126. RETURN a$
  127. ENDFUNC
  128. > PROCEDURE aff_som
  129. BMOVE adr_som%,XBIOS(2),32000
  130. @ligne(0)
  131. RETURN
  132. > PROCEDURE aff_doc
  133. BMOVE adr_doc%,XBIOS(2),32000
  134. RETURN
  135. > PROCEDURE info_memoire
  136. mem_ram$=STR$(FRE(0))+" octets"
  137. mem_disk$=STR$(DFREE(0))+" octets"
  138. disk%=GEMDOS(25)
  139. SELECT disk%
  140. CASE 0
  141.   disk$="A"
  142. CASE 1
  143.   disk$="B"
  144. CASE 2
  145.   disk$="C"
  146. CASE 3
  147.   disk$="D"
  148. CASE 4
  149.   disk$="E"
  150. CASE 5
  151.   disk$="F"
  152. CASE 6
  153.   disk$="G"
  154. CASE 7
  155.   disk$="H"
  156. CASE 8
  157.   disk$="I"
  158. CASE 9
  159.   disk$="J"
  160. CASE 10
  161.   disk$="K"
  162. CASE 11
  163.   disk$="L"
  164. CASE 12
  165.   disk$="M"
  166. DEFAULT
  167.   disk$="?"
  168. ENDSELECT
  169. RETURN
  170. > PROCEDURE affiche_info
  171. DEFTEXT 1,,,13
  172. TEXT 480,144,prog$            !nom du programme
  173. TEXT 480,161,nbe_octets$      !nombre d'octets
  174. TEXT 480,178,nbe_lignes$      !nombre de lignes
  175. TEXT 400,212,statut$          !Satut
  176. TEXT 456,246,mem_ram$         !m‚moire libre
  177. TEXT 456,263,mem_disk$        !disk free
  178. TEXT 456,280,disk$            !disk utilis‚
  179. TEXT 488,314,vitesse$         !vitesse de transfert
  180. DEFTEXT 1,0,0,4
  181. TEXT 136,344,no_serie$
  182. DEFTEXT 1,,,6
  183. TEXT 99,300,"Version "+version$
  184. TEXT 99,310,dat$
  185. DEFTEXT 1,,,13
  186. RETURN
  187. > PROCEDURE config
  188. ALERT 0,"|Non disponible |sur cette version ",1," OK ",ret%
  189. RETURN
  190. > PROCEDURE gere_souris
  191. x=MOUSEX
  192. y=MOUSEY
  193. '  TEXT 100,100,STR$(x)+" "+STR$(y)
  194. IF x>13 AND x<81 AND y>19 AND y<64
  195.   @loading
  196.   ok!=TRUE
  197. ENDIF
  198. IF x>105 AND x<175 AND y>19 AND y<64
  199.   @saving
  200.   ok!=TRUE
  201. ENDIF
  202. IF x>199 AND x<240 AND y>19 AND y<64
  203.   @affiche_prog
  204.   ok!=TRUE
  205. ENDIF
  206. IF x>264 AND x<366 AND y>19 AND y<64
  207.   @imprimer
  208.   ok!=TRUE
  209. ENDIF
  210. IF x>385 AND x<436 AND y>19 AND y<64
  211.   @charge_prog
  212.   ok!=TRUE
  213. ENDIF
  214. IF x>459 AND x<510 AND y>19 AND y<64
  215.   @sauve_prog
  216.   ok!=TRUE
  217. ENDIF
  218. IF x>519 AND x<623 AND y>21 AND y<58
  219.   @fin
  220. ENDIF
  221. '
  222. IF ok!
  223.   @aff_som
  224.   statut$="Attente..."
  225.   @affiche_info
  226.   ok!=FALSE
  227. ENDIF
  228. '
  229. RETURN
  230. > PROCEDURE gere_clavier
  231. clavier=SHR(MENU(14),8)
  232. SELECT clavier
  233. CASE &H3B
  234.   @loading
  235.   ok!=TRUE
  236. CASE &H3C
  237.   @saving
  238.   ok!=TRUE
  239. CASE &H3D
  240.   @affiche_prog
  241.   ok!=TRUE
  242. CASE &H3E
  243.   @imprimer
  244.   ok!=TRUE
  245. CASE &H3F
  246.   @charge_prog
  247.   ok!=TRUE
  248. CASE &H40
  249.   @sauve_prog
  250.   ok!=TRUE
  251. CASE &H44
  252.   @fin
  253. CASE &H62
  254.   @aide
  255. CASE &H61
  256.   @config
  257. ENDSELECT
  258. '
  259. IF ok!
  260.   @aff_som
  261.   statut$="Attente..."
  262.   @affiche_info
  263.   ok!=FALSE
  264. ENDIF
  265. '
  266. RETURN
  267. '
  268. ' ********************** instructions
  269. > PROCEDURE loading
  270. LOCAL v%,choix%,a$,a!,temps%,i%
  271. CLR programme$,nbe_lignes$,nbe_octets$
  272. mem_ram$=STR$(FRE(0))+" octets"
  273. statut$="Casio  Atari"
  274. @aff_som
  275. @affiche_info
  276. ALERT 0," Vitesse de transfert | Casio  Atari ?",3," 600 | 1200 | 2400 ",choix%
  277. IF choix%=1
  278.   vitesse$=" 600"
  279.   v%=8
  280. ELSE IF choix%=2
  281.   vitesse$="1200"
  282.   v%=7
  283. ELSE
  284.   vitesse$="2400"
  285.   v%=4
  286. ENDIF
  287. @affiche_info
  288. ~XBIOS(15,v%,3,142,-1,-1,-1)
  289. ' auxin_base%=XBIOS(14,0)                    !
  290. ' IF DPEEK(auxin_base%+4)<5120               !
  291. ' auxin_buffer%=MALLOC(5120)               !toute cette partie (lignes 42 @ 53)
  292. ' IF auxin_buffer%>0                       !cree un nouveau tampon pour
  293. ' PRINT "nouveau buffer"                 !l'entree des donnes de la prise
  294. ' LPOKE (auxin_base%),auxin_buffer%      !serie. Si le tampon existant est
  295. ' DPOKE (auxin_base%+4),5120             !inferieur a 5Ko, alors on en cree
  296. ' ELSE                                     !un nouveau
  297. ' PRINT "Pas assez de memoire pour le buffer AUXIN"
  298. ' END                                    !
  299. ' ENDIF                                    !
  300. ' ENDIF                                      !
  301. WHILE INP?(1)<>FALSE
  302.   a%=INP(1)
  303. WEND
  304. ALERT 0,"  Tapez SAVE ""COM0:x |x:3 (600),4 (1200),5 (2400) ",1," OK | NON ",ret%
  305. CLR t$
  306. IF ret%=1
  307.   DO
  308.     a$=INPAUX$
  309.     t$=INKEY$
  310.     IF a$<>""
  311.       programme$=programme$+a$
  312.       z%=LEN(programme$)
  313.       TEXT 480,161,STR$(z%)      !nombre d'octets
  314.       @ligne(FRAC(z%/512))
  315.       a!=FALSE
  316.     ELSE IF a!=FALSE
  317.       temps%=TIMER
  318.       a!=TRUE
  319.     ENDIF
  320.   LOOP UNTIL (TIMER-temps%)>200*5*2 OR t$=CHR$(27)
  321.   FOR i%=1 TO LEN(programme$)
  322.     IF MID$(programme$,i%,1)=CHR$(10)
  323.       nbe_lignes$=STR$(VAL(nbe_lignes$)+1)
  324.     ENDIF
  325.   NEXT i%
  326.   nbe_octets$=STR$(LEN(programme$))
  327. ENDIF
  328. RETURN
  329. > PROCEDURE saving
  330. LOCAL choix%,i%,v%
  331. mem_ram$=STR$(FRE(0))+" octets"
  332. statut$="Atari  Casio"
  333. @aff_som
  334. ALERT 0," Vitesse de transfert | Atari  Casio ?",3," 600 | 1200 | 2400 ",choix%
  335. IF choix%=1
  336.   vitesse$=" 600"
  337.   v%=8
  338. ELSE IF choix%=2
  339.   vitesse$="1200"
  340.   v%=7
  341. ELSE
  342.   vitesse$="2400"
  343.   v%=4
  344. ENDIF
  345. @affiche_info
  346. ~XBIOS(15,v%,3,142,-1,-1,-1)
  347. '  auxin_base%=XBIOS(14,0)                    !
  348. '  IF DPEEK(auxin_base%+4)<5120               !
  349. '  auxin_buffer%=MALLOC(5120)               !toute cette partie (lignes 42 @ 53)
  350. '  IF auxin_buffer%>0                       !cree un nouveau tampon pour
  351. '  PRINT "nouveau buffer"                 !l'entree des donnes de la prise
  352. '  LPOKE (auxin_base%),auxin_buffer%      !serie. Si le tampon existant est
  353. '  DPOKE (auxin_base%+4),5120             !inferieur a 5Ko, alors on en cree
  354. ' ELSE                                     !un nouveau
  355. '  PRINT "Pas assez de memoire pour le buffer AUXIN"
  356. '  END                                    !
  357. ' ENDIF                                    !
  358. ' ENDIF                                      !
  359. WHILE INP?(1)<>FALSE
  360.   a%=INP(1)
  361. WEND
  362. ALERT 0,"  Tapez LOAD ""COM0:x |x:3 (600),4 (1200),5 (2400) ",1," OK | NON ",ret%
  363. IF ret%=1
  364.   PAUSE 200
  365.   IF OUT?(1)=FALSE
  366.     ALERT 1," Casio non connect‚ ??? ",1," OK ",ret%
  367.   ELSE
  368.     FOR i%=1 TO LEN(programme$)
  369.       OUT 1,ASC(MID$(programme$,i%,1))
  370.       @ligne(i%/LEN(programme$))
  371.       EXIT IF INKEY$=CHR$(27)
  372.     NEXT i%
  373.   ENDIF
  374. ENDIF
  375. PAUSE 200
  376. RETURN
  377. > PROCEDURE ligne(pourcentage)
  378. GRAPHMODE 1
  379. DEFFILL 1,2,2
  380. IF pourcentage<=0
  381.   PBOX 344,320,576,336
  382. ENDIF
  383. IF pourcentage<=1
  384.   IF pourcentage>0
  385.     DEFFILL 1,2,4
  386.     PBOX 346,322,346+228*pourcentage,334
  387.   ENDIF
  388. ENDIF
  389. RETURN
  390. '
  391. > PROCEDURE imprimer
  392. LOCAL choix%,a$,y,i,x,p
  393. statut$="Impression tampon"
  394. @aff_som
  395. @affiche_info
  396. ALERT 1," Imprimante alum‚e ? ",1,"OUI|NON",choix%
  397. IF choix%=1
  398.   LPRINT "Nom du fichier:";nom_prog$
  399.   LPRINT "Nb lignes:";nbe_lignes$,"Nb octets:";nbe_octets$
  400.   LPRINT
  401.   y=0
  402.   i=1
  403.   x=1
  404.   p=1
  405. bouc:
  406.   a$=""
  407.   REPEAT
  408.     REPEAT
  409.       IF MID$(programme$,i,1)<>CHR$(10) AND MID$(programme$,i,1)<>CHR$(13)
  410.         a$=a$+MID$(programme$,i,1)
  411.       ELSE IF MID$(programme$,i,1)=CHR$(13)
  412.         i=i+1
  413.         x=79
  414.       ENDIF
  415.       x=x+1
  416.       i=i+1
  417.     UNTIL x=80 OR i>=LEN(programme$)
  418.     x=1
  419.     LPRINT a$
  420.     y=y+1
  421.     a$=""
  422.   UNTIL y=57 OR i>=LEN(programme$)
  423.   p=p+1
  424.   LPRINT
  425.   LPRINT "Page No";p
  426.   IF i>=LEN(programme$) AND y<57
  427.     LPRINT "            ******** FIN ********"
  428.   ELSE
  429.     y=0
  430.     ALERT 0," Changement de page ",1," OK ",choix%
  431.     GOTO bouc
  432.   ENDIF
  433. ENDIF
  434. RETURN
  435. '
  436. > PROCEDURE charge_prog
  437. @info_memoire
  438. statut$="Chargement programme"
  439. @aff_som
  440. @affiche_info
  441. CLR programme$,nbe_lignes$,nbe_octets$
  442. '
  443. IF prog$=""
  444.   prog$="CASIO.CAS"
  445. ENDIF
  446. FILESELECT chemin$,prog$,nom_prog$
  447. @test_nom_prog
  448. '
  449. IF (NOT erreur!) AND EXIST(nom_prog$)
  450.   OPEN "i",#1,nom_prog$
  451.   REPEAT
  452.     LINE INPUT #1,a$
  453.     programme$=programme$+CHR$(13)+CHR$(10)+a$
  454.   UNTIL EOF(#1)
  455.   CLOSE #1
  456.   programme$=programme$+CHR$(13)+CHR$(10)
  457.   x=0
  458.   FOR i%=1 TO LEN(programme$)
  459.     IF MID$(programme$,i%,1)=CHR$(10)
  460.       x=x+1
  461.       nbe_lignes$=STR$(VAL(nbe_lignes$)+1)
  462.     ENDIF
  463.   NEXT i%
  464.   nbe_octets$=STR$(LEN(programme$))
  465.   @affiche_info
  466. ENDIF
  467. RETURN
  468. '
  469. > PROCEDURE sauve_prog
  470. @info_memoire
  471. statut$="Sauvegarde programme"
  472. @aff_som
  473. @affiche_info
  474. '
  475. FILESELECT chemin$,prog$,nom_prog$
  476. @test_nom_prog
  477. '
  478. IF NOT erreur!
  479.   OPEN "o",#1,nom_prog$
  480.   PRINT #1,programme$
  481.   CLOSE #1
  482. ENDIF
  483. @affiche_info
  484. RETURN
  485. '
  486. > PROCEDURE fin
  487. ALERT 2,"|Retour au GEM",1," OUI | NON ",ret%
  488. IF ret%=1
  489.   fin!=TRUE
  490.   ' On remet l'ancien Tampon
  491.   xbios14in(initin%,longin%)
  492.   xbios14out(initout%,longout%)
  493.   ' On fait les Mfree
  494.   ~GEMDOS(&H49,L:xxxin%)
  495.   ~GEMDOS(&H49,L:xxxout%)
  496.   a=MFREE(adr_doc)
  497.   a=MFREE(adr_som)
  498.   '    RESERVE
  499. ELSE
  500.   fin!=FALSE
  501. ENDIF
  502. RETURN
  503. '
  504. > PROCEDURE aide
  505. @aff_doc
  506. TEXT 365,180,"- transfert Casio  Atari"
  507. TEXT 365,180+15,"- sauvegarde sur disque"
  508. TEXT 365,180+15*2,"- impression listing"
  509. DEFTEXT 1,1,0,13
  510. TEXT 365,180+15*4,"Programme en ShareWare !"
  511. DEFTEXT 1,0,0,13
  512. TEXT 365,180+15*5,"Merci d'envoyer un chŠque"
  513. TEXT 365,180+15*6,"de 50 Frs …:"
  514. DEFTEXT 1,1,0,6
  515. TEXT 370,180+15*7,"William Saint-Cricq"
  516. TEXT 370,180+15*7+9,"9 R‚sidence Bel Air"
  517. TEXT 370,180+15*7+9*2,"65000 TARBES"
  518. DEFTEXT 1,0,0,4
  519. TEXT 370,180+15*7+9*3,"CCP 2502 C Toulouse"
  520. TEXT 50,180+18*7,"Un grand merci …"
  521. TEXT 50,180+18*7+9,"THE HOBBIT pour son aide."
  522. TEXT 50,180+18*7+9*3,"Un kiss … ma bien aŒm‚e Marie."
  523. DEFTEXT 1,0,0,13
  524. TEXT 250,393,"Tapez sur une touche"
  525. REPEAT
  526. UNTIL INKEY$<>""
  527. @aff_som
  528. @affiche_info
  529. RETURN
  530. '
  531. > PROCEDURE affiche_prog
  532. LOCAL a$,y,i,x,j
  533. y=0
  534. i=1
  535. x=1
  536. @fenetre("Tapez sur ESC pour sortir | RETURN pour la suite","Nb octets:"+nbe_octets$+" | Nb lignes:"+nbe_lignes$)
  537. boucle:
  538. a$=""
  539. REPEAT
  540.   REPEAT
  541.     IF MID$(programme$,i,1)<>CHR$(10) AND MID$(programme$,i,1)<>CHR$(13)
  542.       IF MID$(programme$,i,1)=>" "
  543.         a$=a$+MID$(programme$,i,1)
  544.       ELSE
  545.         a$=a$+" "
  546.       ENDIF
  547.     ELSE IF MID$(programme$,i,1)=CHR$(13)
  548.       i=i+1
  549.       x=66
  550.     ENDIF
  551.     x=x+1
  552.     i=i+1
  553.   UNTIL x=67 OR i>=LEN(programme$)
  554.   x=1
  555.   PRINT AT(7,6+y);a$
  556.   y=y+1
  557.   a$=""
  558. UNTIL y=16 OR i>=LEN(programme$)
  559. IF i>LEN(programme$) AND y<16
  560.   PRINT AT(7,6+y+1);"            ******** FIN ********"
  561. ENDIF
  562. boucle2:
  563. a$=INKEY$
  564. IF a$=CHR$(13) AND i<LEN(programme$)
  565.   y=0
  566.   DEFFILL 1,0
  567.   BOUNDARY 0
  568.   PBOX 49,79,583,343
  569.   GOTO boucle
  570. ENDIF
  571. IF a$<>CHR$(&H1B)
  572.   GOTO boucle2
  573. ENDIF
  574. RETURN
  575. '
  576. ' ********************** divers
  577. > PROCEDURE test_nom_prog
  578. CLR erreur!
  579. IF nom_prog$="" OR nom_prog$="\"
  580.   erreur!=TRUE
  581. ELSE
  582.   prog$=RIGHT$(nom_prog$,12)
  583.   CLR a$
  584.   FOR i%=1 TO LEN(prog$)
  585.     a$=MID$(prog$,i%,1)
  586.     EXIT IF a$="\"
  587.   NEXT i%
  588.   IF i%<LEN(prog$)
  589.     prog$=MID$(prog$,i%+1)
  590.   ENDIF
  591.   erreur!=FALSE
  592.   chemin$=MID$(nom_prog$,1,LEN(nom_prog$)-LEN(prog$))+"*.*"
  593. ENDIF
  594. RETURN
  595. > PROCEDURE fenetre(titre$,info$)
  596. CLS
  597. @aff_doc
  598. DEFFILL 1,2,2
  599. PBOX 25,7,609,43
  600. DEFFILL 1,0
  601. BOUNDARY 0
  602. PBOX 49,79,583,343
  603. PBOX 30,12,604,38
  604. BOUNDARY 1
  605. DEFFILL 1,2,8
  606. PBOX 40,45,595,70
  607. DEFFILL 1,0
  608. PBOX 40,45,593,68
  609. TEXT 37,30,560,titre$
  610. TEXT 50,62,535,info$
  611. RETURN
  612. '
  613. '
  614. '
  615. '
  616.